home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / tools / cie.lha / cie / cie-mouse.el next >
Lisp/Scheme  |  1993-06-21  |  9KB  |  318 lines
  1. ;;; Mouse Settings to make tagnames and filenames "mouseable"
  2.  
  3. ;; Left = This Window;  Middle = Other Window
  4.  
  5. ;; Shift = Tag
  6. (define-key mouse-map x-button-s-left          'x-find-tag-default)
  7. (define-key mouse-map x-button-s-left-up       'x-mouse-ignore)
  8. (define-key mouse-map x-button-s-middle        'x-find-tag-default-other-window)
  9. (define-key mouse-map x-button-s-middle-up     'x-mouse-ignore)
  10. ;; Control = File
  11. (define-key mouse-map x-button-c-left          'x-goto-file)
  12. (define-key mouse-map x-button-c-left-up       'x-mouse-ignore)
  13. (define-key mouse-map x-button-c-middle        'x-goto-file-other-window)
  14. (define-key mouse-map x-button-c-middle-up     'x-mouse-ignore)
  15.  
  16.  
  17. (autoload 'find-tag-default "tags" "Find potential tag at point.")
  18.  
  19. (defun x-find-tag (arg)
  20.   (x-mouse-set-point arg)
  21.   (let ((tag (find-tag-default))) 
  22.     (find-tag tag)
  23.     ;; Wait for and discard the button-up key so the message is not flushed.
  24.     (sit-for 1)
  25.     (discard-input)
  26.     (message "Find tag: %s" tag)))
  27.  
  28.  
  29. (defun x-find-tag-default (arg)
  30.   (x-mouse-set-point arg)
  31.   (let ((tag (find-tag-default))) 
  32.     (message "Find tag: %s" tag)
  33.     (find-tag tag) ))
  34.  
  35.  
  36. (defun x-find-tag-default-other-window (arg)
  37.   (x-mouse-set-point arg)
  38.   (let ((tag (find-tag-default))) 
  39.     (message "Find tag: %s" tag)
  40.     (find-tag-other-window tag) ))
  41.  
  42.  
  43. (defun x-goto-file (arg)
  44.   (x-mouse-set-point arg)
  45.   (let ((goto-file-other-window-p nil))
  46.     (goto-file) ) )
  47.  
  48.  
  49. (defun x-goto-file-other-window (arg)
  50.   (x-mouse-set-point arg)
  51.   (let ((goto-file-other-window-p t))
  52.     (goto-file) ) )
  53.  
  54.  
  55.  
  56. ;;;===== Mouse Command Defuns
  57.  
  58. (defvar x-auto-mouse-select nil
  59.   "When non-nil, always select the window containing the mouse.")
  60.  
  61. ;;; Redefined from x-mouse.el - dont leave the minibuffer via the mouse
  62. (defun x-mouse-select (arg)
  63.   "Select Emacs window the mouse is on."
  64.   (let ((start-w (selected-window))
  65.     (done nil)
  66.     (w (selected-window))
  67.     (rel-coordinate nil))
  68.     (while (and (not done)
  69.         (null (setq rel-coordinate
  70.                 (coordinates-in-window-p arg w))))
  71.       (setq w (next-window w))
  72.       (if (eq w start-w)
  73.       (setq done t)))
  74.     ;; Dont allow the user to exit the minibuffer using the mouse.
  75.     (if (and (eq (selected-window) (minibuffer-window))
  76.          (not (eq w (minibuffer-window))))
  77.     (error ""))
  78.     (select-window w)
  79.     rel-coordinate))
  80.  
  81.  
  82. (defun x-scroll-up (arg)
  83.   "Scroll up the window the mouse is over."
  84.   (let ((owin (selected-window)))
  85.     (if (x-mouse-select arg)
  86.     (progn
  87.       (scroll-up nil)
  88.       (or (eq owin (selected-window))
  89.           x-auto-mouse-select
  90.           (select-window owin))))))
  91.  
  92.  
  93. (defun x-scroll-down (arg)
  94.   "Scroll down the window the mouse is over."
  95.   (let ((owin (selected-window)))
  96.     (if (x-mouse-select arg)
  97.     (progn
  98.       (scroll-down nil)
  99.       (or (eq owin (selected-window))
  100.           x-auto-mouse-select
  101.           (select-window owin))))))
  102.  
  103.  
  104. (defun x-line-to-top (arg)
  105.   "Scroll line at the mouse to top of window."
  106.   (let ((owin (selected-window)))
  107.     (if (x-mouse-select arg)
  108.     (progn
  109.       (save-excursion
  110.         (x-mouse-set-point arg)
  111.         (line-to-top-of-window))
  112.       (or (eq owin (selected-window))
  113.           x-auto-mouse-select
  114.           (select-window owin))))))
  115.  
  116.  
  117. (defun x-line-to-bottom (arg)
  118.   "Scroll line at the mouse to bottom of window."
  119.   (let ((owin (selected-window)))
  120.     (if (x-mouse-select arg)
  121.     (progn
  122.       (save-excursion
  123.         (x-mouse-set-point arg)
  124.         (line-to-bottom-of-window))
  125.       (or (eq owin (selected-window))
  126.           x-auto-mouse-select
  127.           (select-window owin))))))
  128.  
  129.  
  130. (defun x-scroll-up-one (arg)
  131.   "Scroll the window at the mouse one line up."
  132.   (let ((owin (selected-window)))
  133.     (if (x-mouse-select arg)
  134.     (progn
  135.       (scroll-one-line-up 1)
  136.       (or (eq owin (selected-window))
  137.           x-auto-mouse-select
  138.           (select-window owin))))))
  139.  
  140.  
  141. (defun x-scroll-down-one (arg)
  142.   "Scroll the window at the mouse one line up."
  143.   (let ((owin (selected-window)))
  144.     (if (x-mouse-select arg)
  145.     (progn
  146.       (scroll-one-line-down 1)
  147.       (or (eq owin (selected-window))
  148.           x-auto-mouse-select
  149.           (select-window owin))))))
  150.  
  151.  
  152. (defun x-enlarge-window (arg)
  153.   "Select Emacs window mouse is on, then grow it by one line."
  154.   (if (x-mouse-select arg)
  155.       (enlarge-window 1)))
  156.  
  157.  
  158. ;;; Redefined to blink cursor around region
  159. (defun x-cut-text (arg &optional kill)
  160.   "Copy text between point and mouse position into window system cut buffer.
  161. Save in Emacs kill ring also."
  162.   (if (coordinates-in-window-p arg (selected-window))
  163.       (save-excursion
  164.     (let ((opoint (point))
  165.           beg end)
  166.       (x-mouse-set-point arg)
  167.       (sit-for 1)
  168.       (setq beg (min opoint (point))
  169.         end (max opoint (point)))
  170.       (x-store-cut-buffer (buffer-substring beg end))
  171.       (copy-region-as-kill beg end)
  172.       (if kill (delete-region beg end))))
  173.     (message "Mouse not in selected window")))
  174.  
  175.  
  176. (defun x-cut-sexp (arg &optional kill)
  177.   "Copy sexp starting at mouse into window system cut buffer.
  178. Save in Emacs kill ring also."
  179.   (save-window-excursion
  180.     (x-mouse-select arg)
  181.     (save-excursion
  182.       (x-mouse-set-point arg)
  183.       (let ((beg (point))
  184.         end)
  185.     (discard-input)
  186.     (sit-for 1)
  187.     (forward-sexp 1)
  188.     (sit-for 1)
  189.     (setq end (point))
  190.     (x-store-cut-buffer (buffer-substring beg end))
  191.     (copy-region-as-kill beg end)
  192.     (if kill (delete-region beg end))
  193.     ))))
  194.  
  195.  
  196. (defun x-paste-sexp (arg)
  197.   "Copy sexp at mouse into cut buffer and then paste at cursor."
  198.   (x-cut-sexp arg)
  199.   (insert (x-get-cut-buffer)))
  200.  
  201.  
  202. (defun x-cut-and-wipe-word (arg)
  203.   "Kill the word at the mouse."
  204.   (x-mouse-set-point arg)
  205.   (let ((beg (point))
  206.     (end (save-excursion (forward-word 1) (point))))
  207.     (x-store-cut-buffer (buffer-substring beg end))
  208.     (copy-region-as-kill beg end)
  209.     (delete-region beg end)))
  210.  
  211.  
  212. (defun x-cut-and-wipe-sexp (arg)
  213.   "Kill the sexp at the mouse."
  214.   (x-mouse-set-point arg)
  215.   (let ((beg (point))
  216.     (end (save-excursion (forward-sexp 1) (sit-for 1) (point))))
  217.     (x-store-cut-buffer (buffer-substring beg end))
  218.     (copy-region-as-kill beg end)
  219.     (delete-region beg end)))
  220.  
  221.  
  222. (defun x-find-tag (arg)
  223.   (x-mouse-set-point arg)
  224.   (let ((tag (find-tag-default))) 
  225.     (find-tag tag)
  226.     ;; Wait for and discard the button-up key so the message is not flushed.
  227.     (sit-for 1)
  228.     (discard-input)
  229.     (message "Find tag: %s" tag)))
  230.  
  231.  
  232. (defun x-find-tag-default (arg)
  233.   (x-mouse-set-point arg)
  234.   (let ((tag (find-tag-default))) 
  235.     (message "Find tag: %s" tag)
  236.     (find-tag tag) ))
  237.  
  238.  
  239. (defun x-find-tag-default-other-window (arg)
  240.   (x-mouse-set-point arg)
  241.   (let ((tag (find-tag-default))) 
  242.     (message "Find tag: %s" tag)
  243.     (find-tag-other-window tag) ))
  244.  
  245.  
  246. (defun x-goto-file (arg)
  247.   (x-mouse-set-point arg)
  248.   (let ((goto-file-other-window-p nil))
  249.     (goto-file) ) )
  250.  
  251.  
  252. (defun x-goto-file-other-window (arg)
  253.   (x-mouse-set-point arg)
  254.   (let ((goto-file-other-window-p t))
  255.     (goto-file) ) )
  256.  
  257.  
  258. (defun x-search-forward (arg)
  259.   (x-mouse-set-point arg)
  260.   (skip-chars-forward " \t")
  261.   (let* ((end (progn (forward-sexp 1) (point)))
  262.      (start (save-excursion (forward-sexp -1) (point)))
  263.      (string (buffer-substring start end)))
  264.     (search-forward string)))
  265.  
  266.  
  267. (defun x-search-backward (arg)
  268.   (x-mouse-set-point arg)
  269.   (skip-chars-forward " \t")
  270.   (let* ((end (progn (forward-sexp 1) (point)))
  271.      (start (progn (forward-sexp -1) (point)))
  272.      (string (buffer-substring start end)))
  273.     (search-backward string)))
  274.  
  275.  
  276. ;; Redefined to prevent clobbering "last-command" which is used by
  277. ;; x-search-forward/backward
  278.  
  279. (defun x-flush-mouse-queue () 
  280.   "Process all queued mouse events."
  281.   ;; A mouse event causes a special character sequence to be given
  282.   ;; as keyboard input.  That runs this function, which process all
  283.   ;; queued mouse events and returns.
  284.   (interactive)
  285.   (while (> (x-mouse-events) 0)
  286.     (x-proc-mouse-event)
  287.     (and (boundp 'x-process-mouse-hook)
  288.      (symbol-value 'x-process-mouse-hook)
  289.      (funcall x-process-mouse-hook x-mouse-pos x-mouse-item)))
  290.   
  291.   )
  292.  
  293.  
  294. ;; the following function may look very much like x-buffer-menu
  295. (defun x-command-history-menu (arg)
  296.   "Pop up a menu of command history for selection with the mouse."
  297.   (let ((menu
  298.          (list "Command History Menu"
  299.                (cons "Select Command"
  300.                      (let ((tail command-history)
  301.                            (prev "^ "); non existent command
  302.                            head)
  303.                        (while tail
  304.                          (let ((elt (car tail)))
  305.                            (if (not (string-match prev
  306.                                                   (prin1-to-string elt)))
  307.                                (setq head (cons
  308.                                            (cons
  309.                                              (setq prev (prin1-to-string elt))
  310.                                             elt)
  311.                                            head))))
  312.                          (setq tail (cdr tail)))
  313.                        (if head (reverse head)
  314.                          (setq head (cons (cons "command-history empty"
  315.                                                 (prin1-to-string nil)) head)))
  316.                        )))))
  317.     (eval (x-popup-menu arg menu))))
  318.